home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / sysclok.exe / SYSCLOCK.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-29  |  3.9 KB  |  121 lines
  1. 'Declare API functions for writing to .ini file
  2. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  3. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  4.  
  5. 'Global variables
  6. Global TitleBarFlag As Integer
  7. Global AddResFlag As Integer
  8. Global OnTopFlag As Integer
  9. Global HideFlag As Integer
  10. Global xRes As Integer  'Variable for horizontal resolution
  11.  
  12. 'Declare API function for always on top
  13. Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
  14.  
  15. 'Declare API functions for getting resource space
  16. Declare Function GetModuleHandle Lib "Kernel" (ByVal ModName$) As Integer
  17. Declare Function GetHeapSpaces& Lib "Kernel" (ByVal hModule As Integer)
  18.  
  19.  
  20. Sub BorderFrame (F As Form, TOffset As Integer, LOffset As Integer, BOffset As Integer, ROffset As Integer)
  21. '*****
  22. 'This sub draws a 3D frame around the form offset from each edge by the
  23. '    values specified from the call
  24. '*****
  25.  
  26.     F.DrawWidth = 2
  27.     H = F.Height: W = F.Width
  28.  'Draw border frame
  29.     F.ForeColor = &HE0E0E0  'White line color
  30.     'Top line
  31.     F.Line (0 + LOffset, 0 + TOffset)-(W - ROffset, 0 + TOffset)
  32.     'Left side line
  33.     F.Line (0 + LOffset, 0 + TOffset)-(0 + LOffset, H - BOffset)
  34.  
  35.     F.ForeColor = &H808080  'Gray line color
  36.     'Right side line
  37.     F.Line (W - ROffset, 0 + TOffset)-(W - ROffset, H - BOffset)
  38.     'Bottom
  39.     F.Line (0 + LOffset, H - BOffset)-(W - ROffset, H - BOffset)
  40. End Sub
  41.  
  42. Sub Frame (F As Form, TB As Control, Effect As Integer)
  43.   L = TB.Left - 50
  44.   T = TB.Top - 40
  45.   H = TB.Height + 80
  46.   W = TB.Width + 90
  47.   OFFSET = 4
  48.   BIGOFFSET = 6
  49.   F.DrawWidth = 1
  50. 'Set initial colors to a recessed effect
  51.     ForeColor1 = &HE0E0E0
  52.     ForeColor2 = &H808080
  53. 'Change colors if a raised Effect
  54.     If Effect% <> 1 Then
  55.     ForeColor2 = &HE0E0E0
  56.     ForeColor1 = &H808080
  57.     End If
  58. 'First draw bottom & right in one color
  59.     F.ForeColor = ForeColor1
  60. 'bottom:
  61.     F.Line (L + F.DrawWidth, T + H + OFFSET)-(L + W - F.DrawWidth, T + H + OFFSET)
  62. 'right:
  63.     F.Line (L + W + OFFSET, T + F.DrawWidth)-(L + W + OFFSET, T + H + OFFSET - F.DrawWidth)
  64.  
  65. 'Next draw left and top in other color
  66.     F.ForeColor = ForeColor2
  67. 'top:
  68.     F.Line (L - BIGOFFSET + F.DrawWidth, T - BIGOFFSET)-(L + W + BIGOFFSET - F.DrawWidth, T - BIGOFFSET)
  69. 'left:
  70.     F.Line (L - BIGOFFSET, T + F.DrawWidth - BIGOFFSET)-(L - BIGOFFSET, T + H + BIGOFFSET - F.DrawWidth)
  71.  
  72. End Sub
  73.  
  74. Sub GetFreeResouces ()
  75.  
  76. End Sub
  77.  
  78. Function GetFreeResources& (ModuleName$)
  79.     rInfo& = GetHeapSpaces&(GetModuleHandle(ModuleName$))
  80.     Totalr& = HiWord&(rInfo&)
  81.     FreeR& = LoWord(rInfo&)
  82.     GetFreeResources& = FreeR& * 100 \ Totalr&
  83. End Function
  84.  
  85. Function HiWord& (LongInt&)
  86.     Temp& = LongInt& \ &H10000
  87.     If Temp& < 0 Then Temp& = Temp& + &H10000
  88.     HiWord& = Temp&
  89. End Function
  90.  
  91. Function LoWord& (LongInt&)
  92.     Temp& = LongInt& Mod &H10000
  93.     If Temp& < 0 Then Temp& = Temp& + &H10000
  94.     LoWord& = Temp&
  95. End Function
  96.  
  97. Function Min (P1, P2)
  98.     If P1 < P2 Then Min = P1 Else Min = P2
  99. End Function
  100.  
  101. Sub SetFrmSize ()
  102.     SysClockFrm.Label1.Width = SysClockFrm.TextWidth(SysClockFrm.Label1.Caption)
  103.     SysClockFrm.Width = SysClockFrm.Label1.Width + 200
  104. End Sub
  105.  
  106. Sub SetStayOnTop (Value As Integer)
  107. '*****
  108. 'This sub controls whether window stays on top with API call
  109. '*****
  110.  
  111. wFlags = &H2 Or &H1 Or &H40 Or &H10
  112. If Value Then
  113.    OnTop% = SetWindowPos(SysClockFrm.hWnd, -1, 0, 0, 0, 0, wFlags)
  114. Else
  115.    Norml% = SetWindowPos(SysClockFrm.hWnd, -2, 0, 0, 0, 0, wFlags)
  116.    SysClockFrm.ZOrder 1
  117. End If
  118.  
  119. End Sub
  120.  
  121.